home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte1286.arc / ENNS.ARC / CURVTEST.BAS < prev    next >
BASIC Source File  |  1986-07-07  |  13KB  |  303 lines
  1. 1 '    ╔══════════════╦═════════════════════════╦════════════════════════╗
  2. 2 '    ║ CurvTest     ║     0277 Lines          ║ Steve Enns Feb.21 1985 ║
  3. 3 '    ║ Version 1.1  ║     11136 Bytes         ║       Com. Feb.21 1985 ║
  4. 4 '    ╚══════════════╩═════════════════════════╩════════════════════════╝
  5. 5 '
  6. 10 '------------ Entry ---------------------------------------------------------
  7. 11 '
  8. 12 '----- Versions of BASIC for PC's other then the TI PC will likely require
  9. 13 '----- that this program initialize the graphics screen. The resolution
  10. 14 '----- of the graphics screen is given in lines 70 and 80. Line 80 contains
  11. 15 '----- the maximum x and y coordinates. The fourth place in a COLOR state-
  12. 16 '----- ment is the character attribute. (flashing, reverse video, etc.)
  13. 17 '----- Lines 4030 to 4050 draw and store a cross-hair cursor. Different
  14. 18 '----- screen resolutions may require a larger or smaller cursor. GSX and
  15. 19 '----- GSY determine how far the cursor will move on a shifted-arrow key.
  16. 20 '----- Both graphics and text on the same screen are required.
  17. 29 '
  18. 30 '----------- Initialize storage and variables -------------------------------
  19. 40 '
  20. 50 DEFINT X,Y
  21. 60 DIM XC(300),YC(300),X(5000),Y(5000)          '----- Ctrl and curve points
  22. 70 XVI=0:YVI=0                                  '----- Upper left of Gr. screen
  23. 80 X1VI=719:Y1VI=299                            '----- Lower Right of Gr. screen
  24. 90 GSX=30:GSY=20                                '----- See GRCURSOR.SUB
  25. 100 GRIDIS=1                                    '----- See GRCURSOR.SUB
  26. 110 I=1                                         '----- Count of ctrl points
  27. 120 NBS=.05                                     '----- Increment (Curv.SUB's)
  28. 130 QBS=2:QBZ=4                                 '----- Colors for curves
  29. 140 '
  30. 150 '---------- Clear the screen -----------------------------------------------
  31. 160 '
  32. 170 CLS:KEY OFF:COLOR 3,,,0:LOCATE ,,0
  33. 180 '
  34. 190 '---------- Initialize function keys ---------------------------------------
  35. 200 '
  36. 210 KEY 1,"POINT ":ON KEY(1) GOSUB 600:KEY(1) ON
  37. 220 KEY 2,"SPLINE":ON KEY(2) GOSUB 770:KEY(2) ON
  38. 230 KEY 3,"BEZIER":ON KEY(3) GOSUB 850:KEY(3) ON
  39. 240 KEY 4,"EPOINT":ON KEY(4) GOSUB 690:KEY(4) ON
  40. 250 KEY 5,"ERASE ":ON KEY(5) GOSUB 940:KEY(5) ON
  41. 252 KEY 6,"EXIT  ":ON KEY(6) GOSUB 996:KEY(6) ON
  42. 260 '
  43. 270 KEY ON
  44. 280 LOCATE 25,48:PRINT STRING$(32,32)
  45. 281 '
  46. 282 '---------- Title ----------------------------------------------------------
  47. 283 '
  48. 290 COLOR 7,,,0:LOCATE 1,1
  49. 291 PRINT"╔══════════╗"
  50. 293 PRINT"║ CURVTEST ║"
  51. 294 PRINT"╚══════════╝"
  52. 297 '
  53. 298 '---------- Main program ---------------------------------------------------
  54. 299 '
  55. 300 GOSUB 4040                                  '----- Init. (GRCURSOR.SUB)
  56. 310 GOSUB 3852                                  '----- Enter crosshair loop
  57. 320 '
  58. 330 '---------- Application specific subroutines -------------------------------
  59. 340 '
  60. 350 '---------- Update cursor coordinates --------------------------------------
  61. 360 '
  62. 370 COLOR 7,,,0:LOCATE 25,50
  63. 372 PRINT"Cursor:  x=";XPOS;"  y=";YPOS;
  64. 380 RETURN
  65. 450 '
  66. 460 '---------- Erase message --------------------------------------------------
  67. 470 '
  68. 480 COLOR 3,,,0:LOCATE 23,70
  69. 490 PRINT"       ";
  70. 500 RETURN
  71. 510 '
  72. 520 '---------- Initialize control points for curves ---------------------------
  73. 530 '
  74. 540 XNC=1:XNB=I-1:I2=I:I=1                      '----- Init. ctrl point position
  75. 542 COLOR 7,,,16+64:LOCATE 23,70
  76. 544 PRINT"WORKING";                             '----- Print working message
  77. 550 RETURN
  78. 560 '
  79. 570 '---------- Function key interrupt vectors ---------------------------------
  80. 580 '
  81. 590 '---------- Get control points - (POINT) -----------------------------------
  82. 600 '
  83. 610 XC(I)=XPOS:YC(I)=YPOS
  84. 620 GOSUB 3930
  85. 630 PSET(XC(I),YC(I)),7                         '----- Set pixel (xc(i),yc(i)),
  86. 640 GOSUB 3930                                        'with color 7
  87. 650 I=I+1
  88. 660 RETURN
  89. 670 '
  90. 680 '---------- Erase control points - (EPOINT) --------------------------------
  91. 690 '
  92. 700 FOR IC=1 TO I2
  93. 710    IF POINT(XC(IC),YC(IC))=QBS OR POINT(XC(IC),YC(IC))=QBZ THEN 730
  94. 720    PSET(XC(IC),YC(IC)),0                    '----- Check for pixels, else
  95. 730 NEXT                                              'erase the pixel, color 0
  96. 740 RETURN
  97. 750 '
  98. 760 '---------- Put B-spline - (SPLINE) ----------------------------------------
  99. 770 '
  100. 780 GOSUB 540                                   '----- Init. curve ctrl points
  101. 800 GOSUB 16880                                 '----- Calc. and draw spline
  102. 810 GOSUB 480                                   '----- Erase message
  103. 820 RETURN
  104. 830 '
  105. 840 '---------- Put Bezier curve - (BEZIER) ------------------------------------
  106. 850 '
  107. 860 GOSUB 540                                   '----- Init. curve ctrl points
  108. 880 GOSUB 16990                                 '----- Calc. and draw Bez. curve
  109. 890 GOSUB 480                                   '----- Erase message
  110. 900 RETURN
  111. 910 '
  112. 920 '---------- Clear screen - (CLEAR) -----------------------------------------
  113. 930 '
  114. 940 GOSUB 3930
  115. 950 CLS 1                                       '----- Clear graphic and text
  116. 970 GOSUB 3930
  117. 980 GOSUB 370
  118. 990 RETURN
  119. 992 '
  120. 993 '---------- Leave program - (EXIT) -----------------------------------------
  121. 994 '
  122. 996 GOSUB 9821                                  '----- Replace key definitions
  123. 997 COLOR 3,,,0:CLS
  124. 998 END
  125. 1000 '
  126. 1010 '--------- General subroutines --------------------------------------------
  127. 1020 '
  128. 3780 ' Grcursor.SUB  (Altered)                  Steve Enns Dec.26 1983
  129. 3790 '
  130. 3800 '          Calling program must execute a GOSUB 4040 to init. cursor
  131. 3810 '          Clears screen area descibed below
  132. 3820 '          XVI,YVI,X1VI,Y1VI is the viewport
  133. 3830 '          GRIDIS is 1 for no grid displayed
  134. 3840 '          GSX,GSY are the grid increments
  135. 3850 '
  136. 3852 GOSUB 4000
  137. 3854 GOSUB 4872
  138. 3858 IF GRIDIS THEN 3870
  139. 3860 X=XVI:Y=YVI:X1=X1VI:Y1=Y1VI:XS=GSX:YS=GSY:Q=1
  140. 3861 GOSUB 8340
  141. 3870 XCEN=XVI+.5*(X1VI-XVI):YCEN=YVI+.5*(Y1VI-YVI)
  142. 3871 XPOS=XCEN:YPOS=YCEN
  143. 3872 GOSUB 3950
  144. 3879 Q9$=INKEY$
  145. 3880 IF Q9$="" THEN 3879
  146. 3882 GOSUB 3930
  147. 3883 IF Q9$=LQ$ THEN XPOS=XPOS-1:GOTO 3950
  148. 3884 IF Q9$=RQ$ THEN XPOS=XPOS+1:GOTO 3950
  149. 3885 IF Q9$=DQ$ THEN YPOS=YPOS+1:GOTO 3950
  150. 3886 IF Q9$=UQ$ THEN YPOS=YPOS-1:GOTO 3950
  151. 3888 IF Q9$=HQ$ THEN MODE$="set":GOTO 3950
  152. 3890 IF Q9$=SRQ$ THEN XPOS=XPOS+GSX:GOTO 3950
  153. 3892 IF Q9$=SLQ$ THEN XPOS=XPOS-GSX:GOTO 3950
  154. 3894 IF Q9$=SDQ$ THEN YPOS=YPOS+GSY:GOTO 3950
  155. 3896 IF Q9$=SUQ$ THEN YPOS=YPOS-GSY:GOTO 3950
  156. 3900 IF Q9$=SHQ$ THEN XPOS=XCEN:YPOS=YCEN:GOTO 3950 ELSE 3950
  157. 3920 '          Erase cursor
  158. 3930 PUT(XC,YC),CUR                             '----- Put image CUR at XC,YC
  159. 3932 RETURN
  160. 3940 '          Put cursor
  161. 3950 GOSUB 3970
  162. 3951 GOSUB 370
  163. 3952 XC=XPOS-15:YC=YPOS-9
  164. 3953 PUT (XC,YC),CUR                            '----- Put image CUR at XC,YC
  165. 3954 GOTO 3879
  166. 3960 '          Check values
  167. 3970 IF XPOS<XVI+15 THEN XPOS=XVI+15:BEEP
  168. 3971 IF XPOS>X1VI-15 THEN XPOS=X1VI-15:BEEP
  169. 3980 IF YPOS<YVI+9 THEN YPOS=YVI+9:BEEP
  170. 3981 IF YPOS>Y1VI-8 THEN YPOS=Y1VI-8:BEEP
  171. 3990 RETURN
  172. 4000 IF XVI<0 THEN XVI=0 ELSE IF XVI>719 THEN XVI=719
  173. 4010 IF YVI<0 THEN YVI=0 ELSE IF YVI>299 THEN YVI=299
  174. 4020 RETURN
  175. 4030 '          Draw and get cursor
  176. 4040 DEFINT C:DIM CTEMP(110),CUR(110)
  177. 4041 GET (0,0)-(29,17),CTEMP
  178. 4042 LINE (0,0)-(29,17),0,BF                    '----- Define the cursor
  179. 4043 LINE (0,9)-(8,9),6:LINE (21,9)-(29,9),6    '----- lines (x,y) to (x1,y1)
  180. 4044 LINE (15,0)-(15,4),7:LINE (15,13)-(15,17),7
  181. 4045 PSET(15,9),7
  182. 4046 GET (0,0)-(29,17),CUR                      '----- Store image in array CUR
  183. 4047 LINE (0,0)-(29,17),0,BF
  184. 4048 PUT(0,0),CTEMP
  185. 4049 ERASE CTEMP                                '----- Erase the array CTEMP
  186. 4050 RETURN
  187. 4820 ' Arowinit.SUB                             Steve Enns Dec.18 1983
  188. 4830 '
  189. 4840 '         Initializes arrow keys for trapping
  190. 4850 '         Returns LQ$,RQ$,UQ$,DQ$,HQ$ as the arrow keys on return
  191. 4860 '         Returns SLQ$,SRQ$,SUQ$,SDQ$,SHQ$ as the shifted arrow keys
  192. 4870 '
  193. 4872 LQ$=CHR$(0)+"K":RQ$=CHR$(0)+"M"
  194. 4874 UQ$=CHR$(0)+"H":DQ$=CHR$(0)+"P"
  195. 4876 HQ$=CHR$(0)+"G":SRQ$=CHR$(0)+"è"
  196. 4878 SLQ$=CHR$(0)+"ï":SUQ$=CHR$(0)+"ê"
  197. 4879 SDQ$=CHR$(0)+"ë":SHQ$=CHR$(0)+"å"
  198. 4880 RETURN
  199. 9810 ' Baskeys.SUB                              Steve Enns Dec. 30 1983
  200. 9812 '
  201. 9815 '            Initializes keys to BASIC defaults
  202. 9820 '
  203. 9821 KEY 1,CHR$(27)+"LIST "
  204. 9822 KEY 2,CHR$(27)+"RUN"+CHR$(13)
  205. 9823 KEY 3,"LOAD"+CHR$(34)
  206. 9824 KEY 4,"SAVE"+CHR$(34)
  207. 9825 KEY 5,CHR$(27)+"FILES"+CHR$(13)
  208. 9826 KEY 6,CHR$(27)+"CONT"+CHR$(13)
  209. 9827 KEY 7,".SUB"
  210. 9828 KEY 8,".UTL"
  211. 9829 KEY 9,CHR$(27)+"COLOR 3,0,0,0"+CHR$(13)
  212. 9830 KEY 10,CHR$(27)+"PALETTE"+CHR$(13)
  213. 9840 RETURN
  214. 16850 ' BSpline.SUB                             Steve Enns Dec.20 1984
  215. 16852 '                                         From Fund. of Int CG. p.521
  216. 16854 '
  217. 16856 '         Calculates cubic parametric free-form splines
  218. 16858 '         XBS23=1 for 3d else 2d
  219. 16860 '         XBSDR=0 if the curve is to be drawn
  220. 16862 '         XC(),YC(),[ ZC() ] are the control points
  221. 16864 '         XNC is the index of first control point
  222. 16866 '         XNB is the number of control points to be used
  223. 16868 '         XNP is the index for the first spline point
  224. 16870 '         NBS is the step size
  225. 16872 '         QBS is the color if drawn
  226. 16874 '         Returns X(),Y(),[ Z() ] as the points
  227. 16876 '         Returns XNS as the index of the last spline point
  228. 16878 '
  229. 16880 IS=XNP:XXS=XNC+XNB-3:NSA=1/6:NSB=2/3
  230. 16882 IF XBS23 THEN 16904
  231. 16884 FOR IIS=XNC+1 TO XXS
  232. 16886    FOR T=0 TO 1 STEP NBS
  233. 16888       T1=T/2:T2=T*T:T2A=T2/2:T3=T2*T:T3A=T3/2
  234. 16890       NC1=-NSA*T3+T2A-T1+NSA:NC2=T3A-T2+NSB:NC3=-T3A+T2A+T1+NSA:NC4=NSA*T3
  235. 16892       X(IS)=NC1*XC(IIS-1)+NC2*XC(IIS)+NC3*XC(IIS+1)+NC4*XC(IIS+2)
  236. 16894       Y(IS)=NC1*YC(IIS-1)+NC2*YC(IIS)+NC3*YC(IIS+1)+NC4*YC(IIS+2)
  237. 16896       IS=IS+1
  238. 16898    NEXT
  239. 16900 NEXT
  240. 16902 GOTO 16924
  241. 16904 FOR IIS=XNC+1 TO XXS
  242. 16906    FOR T=0 TO 1 STEP NBS
  243. 16908       T1=.5*T:T2=T*T:T2A=.5*T2:T3=T2*T:T3A=T3/2
  244. 16910       NC1=-NSA*T3+T2A-T1+NSA:NC2=T3A-T2+NSB:NC3=-T3A+T2A+T1+NSA:NC4=NSA*T3
  245. 16912       X(IS)=NC1*XC(IIS-1)+NC2*XC(IIS)+NC3*XC(IIS+1)+NC4*XC(IIS+2)
  246. 16914       Y(IS)=NC1*YC(IIS-1)+NC2*YC(IIS)+NC3*YC(IIS+1)+NC4*YC(IIS+2)
  247. 16916       Z(IS)=NC1*ZC(IIS-1)+NC2*ZC(IIS)+NC3*ZC(IIS+1)+NC4*ZC(IIS+2)
  248. 16918       IS=IS+1
  249. 16920    NEXT
  250. 16922 NEXT
  251. 16924 XNS=IS
  252. 16926 IF XBSDR THEN 16936
  253. 16928 PSET(X(XNP),Y(XNP)),QBS                   '----- Set pixel, x,y color QBS
  254. 16930 FOR II=XNP TO XNP+XNS-1
  255. 16932    LINE -(X(II),Y(II)),QBS                '----- Line from last X,Y to
  256. 16934 NEXT                                            'X1,Y1  color QBS
  257. 16936 RETURN
  258. 16960 ' Bezier2.SUB                             Steve Enns Dec.22 1984
  259. 16962 '                                         From Fund. of Int CG. p.519
  260. 16964 '
  261. 16966 '         Calculates cubic parametric free-form Bezier curves
  262. 16968 '         XBS23=1 for 3d else 2d
  263. 16970 '         XBZDR=0 is the curve is to be drawn (2d only)
  264. 16972 '         XC(),YC(),[ ZC() ] are the hull points (4 per curve)
  265. 16974 '         XNC is the index of first control point
  266. 16976 '         XNB is the number of control points to be used
  267. 16978 '         XNP is the index for the first curve point
  268. 16980 '         NBS is the step size (default provided)
  269. 16982 '         QBZ is the color if drawn
  270. 16984 '         Returns X(),Y(),[ Z() ] as the points
  271. 16986 '         Returns XNS as the index of the last curve point
  272. 16988 '
  273. 16990 IS=XNP:XXS=XNC+XNB-1
  274. 16992 IF NBS=0 THEN NBS=.1
  275. 16994 IF XBS23 THEN 17016
  276. 16996 FOR IIS=XNC TO XXS STEP 4
  277. 16998    FOR T=0 TO 1+NBS STEP NBS
  278. 17000       T2=T*T:T3=T2*T
  279. 17002       NC1=1-3*T+3*T2-T3:NC2=3*T3-6*T2+3*T:NC3=3*T2-3*T3:NC4=T3
  280. 17004       X(IS)=NC1*XC(IIS)+NC2*XC(IIS+1)+NC3*XC(IIS+2)+NC4*XC(IIS+3)
  281. 17006       Y(IS)=NC1*YC(IIS)+NC2*YC(IIS+1)+NC3*YC(IIS+2)+NC4*YC(IIS+3)
  282. 17008       IS=IS+1
  283. 17010    NEXT
  284. 17012 NEXT
  285. 17014 GOTO 17036
  286. 17016 FOR IIS=XNC TO XXS STEP 4
  287. 17018    FOR T=0 TO 1+NBS STEP NBS
  288. 17020       T2=T*T:T3=T2*T
  289. 17022       NC1=1-3*T+3*T2-T3:NC2=3*T3-6*T2+3*T:NC3=3*T2-3*T3:NC4=T3
  290. 17024       X(IS)=NC1*XC(IIS)+NC2*XC(IIS+1)+NC3*XC(IIS+2)+NC4*XC(IIS+3)
  291. 17026       Y(IS)=NC1*YC(IIS)+NC2*YC(IIS+1)+NC3*YC(IIS+2)+NC4*YC(IIS+3)
  292. 17028       Z(IS)=NC1*ZC(IIS)+NC2*ZC(IIS+1)+NC3*ZC(IIS+2)+NC4*ZC(IIS+3)
  293. 17030       IS=IS+1
  294. 17032    NEXT
  295. 17034 NEXT
  296. 17036 XNS=IS-1
  297. 17038 IF XBZDR THEN 17048
  298. 17040 PSET(X(XNP),Y(XNP)),QBZ                   '----- Pixel at x,y color QBZ
  299. 17042 FOR II=XNP TO XNP+XNS
  300. 17044    LINE -(X(II),Y(II)),QBZ                '----- Line from last X,Y to
  301. 17046 NEXT                                            'X1,Y1 color QBZ
  302. 17048 RETURN
  303.            '----- Line from last X,